home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Environments
/
MacMETH 3.2.4
/
More Examples
/
Mandelbrot.MOD
< prev
next >
Wrap
Text File
|
1996-06-20
|
6KB
|
211 lines
MODULE Mandelbrot; (* HS 29-Jan-90 *)
FROM Terminal IMPORT BusyRead;
FROM InOut IMPORT Read, ReadInt, ReadReal, WriteReal,
WriteString, WriteLn, Write, Done;
FROM GraphicWindows IMPORT Window, Mode, OpenGraphicWindow, CloseGraphicWindow,
Circle, Clear, SetMode, SetPen, MoveTo, Dot, IdentifyPos;
FROM CursorMouse IMPORT GetMouse;
FROM FileSystem IMPORT File, Response, Lookup, Close, WriteChar;
FROM Conversions IMPORT IntToString, LongIntToString;
IMPORT Windows;
CONST NrPixels = 196;
(* colours *)
white = 449;
red = 193;
yellow = 65;
green = 321;
zyan = 257;
blue = 385;
magenta = 129;
black = 1;
VAR ch : CHAR;
w,v : Window;
ix,iy,ox,oy,dx : INTEGER;
ux,uux,uy,uuy : REAL;
rinic,iinic : REAL;
sizec,step : REAL;
sizex : REAL;
rinix,iinix : REAL;
lim : INTEGER;
colour : ARRAY [0 .. 2048] OF INTEGER;
PROCEDURE ForeColour (c : LONGINT); CODE 0A862H;
PROCEDURE BackColour (c : LONGINT); CODE 0A863H;
PROCEDURE GetPos(VAR i,j: INTEGER);
CONST ML = 15;
VAR mouse : BITSET; x,y : INTEGER;
BEGIN mouse := {};
REPEAT GetMouse(mouse,x,y) UNTIL NOT(ML IN mouse);
REPEAT GetMouse(mouse,x,y) UNTIL ML IN mouse;
REPEAT GetMouse(mouse,x,y) UNTIL NOT(ML IN mouse);
IdentifyPos(w,x,y);
i := x; j := y;
END GetPos;
PROCEDURE Mandel(cx0, cy0, sz0: REAL);
VAR ix, iy, k : INTEGER; x, y, xx, yy, cx, cy : REAL;
BEGIN (* z := z*z + c *)
FOR ix := 0 TO NrPixels DO
cx := cx0 + (FLOAT(ix) * sz0) / FLOAT(NrPixels);
FOR iy := 0 TO NrPixels DO
cy := cy0 + (FLOAT(iy) * sz0) / FLOAT(NrPixels);
x := 0.0; y := 0.0;
xx := 0.0; yy := 0.0;
k := 0;
REPEAT
y := 2.0*x*y + cy;
x := xx - yy + cx;
xx := x*x;
yy := y*y;
INC (k);
UNTIL ((xx + yy) > 4.0) OR (k >= lim);
IF k >= lim THEN
Windows.SetWindow(w);
IF (cx = 0.0) OR (cy = 0.0) THEN ForeColour(yellow)
ELSIF (cx = 0.25) & (ABS(cy) < 0.1) THEN ForeColour(yellow)
ELSE ForeColour(zyan) END;
Dot(w,ix,iy);
Windows.ResetWindow;
END;
END (* For *);
BusyRead(ch);
IF ch = 177C THEN ix := NrPixels END;
END (* For *);
END Mandel;
PROCEDURE Fractal(cx0, cy0, x0, y0, sz0 : REAL);
VAR ix, iy, k : INTEGER; x, y, xx, yy, delta : REAL;
BEGIN (* z := z*z + c *)
FOR ix := 0 TO NrPixels DO
FOR iy := 0 TO NrPixels DO
x := x0 + (FLOAT(ix) * sz0 / FLOAT(NrPixels));
y := y0 + (FLOAT(iy) * sz0 / FLOAT(NrPixels));
xx := x*x; yy := y*y;
k := 0;
REPEAT
y := 2.0*x*y + cy0;
x := xx - yy + cx0;
xx := x*x;
yy := y*y;
INC (k);
UNTIL ((xx + yy) > 10.0) OR (k >= lim);
IF k >= lim THEN
Windows.SetWindow(v);
ForeColour(red);
Dot(v,ix,iy);
Windows.ResetWindow;
END;
END (* For *);
BusyRead(ch);
IF ch = 177C THEN ix := NrPixels END;
END (* For *);
END Fractal;
PROCEDURE SetColours(lim : INTEGER);
VAR n, int : INTEGER;
BEGIN
int := lim DIV 12;
FOR n := 0 TO lim DO colour[n] := blue END;
colour[lim] := red;
END SetColours;
BEGIN
rinic := -2.25;
iinic := -1.5;
sizec := 3.0;
lim := 100;
OpenGraphicWindow(w,100,40,NrPixels,NrPixels+20,"Mandelbrot",Clear);
SetColours(lim);
LOOP
WriteString ('drawing Mandelbrot set.'); WriteLn;
Mandel(rinic, iinic, sizec); ch := 0C;
WriteString ('zoom requested Y/N:');
Read(ch); Write(CAP(ch)); WriteLn;
IF CAP(ch) # "Y" THEN EXIT END;
WriteString("nr. iterations: "); ReadInt(lim); WriteLn;
WriteString ('define window !'); WriteLn;
step := sizec / FLOAT(NrPixels);
GetPos(ix,iy);
ox := ix; oy := iy;
ux := rinic + FLOAT(ix)*step;
uy := iinic + FLOAT(iy)*step;
GetPos(ix,iy);
dx := ABS(ix-ox);
uux := rinic + FLOAT(ix)*step;
uuy := iinic + FLOAT(iy)*step;
rinic := ux;
iinic := uy;
sizec := ABS(uux - ux);
Windows.SetWindow(w);
ForeColour(black);
SetPen(w,ox,oy); MoveTo(w,ix,oy);
SetPen(w,ix,oy); MoveTo(w,ix,oy+dx);
SetPen(w,ix,oy+dx); MoveTo(w,ox,oy+dx);
SetPen(w,ox,oy+dx); MoveTo(w,ox,oy);
Windows.ResetWindow;
GetPos(ix,iy); (* wait for mouse click *)
Clear(w);
END;
OpenGraphicWindow(v,360,40,NrPixels,NrPixels+20,"Julia Set",Clear);
LOOP
WriteString ('give c for julia set'); WriteLn;
WriteString ('define mouse-point !'); WriteLn;
GetPos(ix,iy);
ox := ix; oy := iy;
ux := rinic + (FLOAT(ix)*sizec / FLOAT(NrPixels));
uy := iinic + (FLOAT(iy)*sizec / FLOAT(NrPixels));
Windows.SetWindow(w);
ForeColour(black);
SetPen(w,ox,oy); Dot(w,ox,oy);
SetPen(w,ox,oy); MoveTo(w, ox+2, oy);
SetPen(w,ox,oy); MoveTo(w, ox-2, oy);
SetPen(w,ox,oy); MoveTo(w, ox, oy+2);
SetPen(w,ox,oy); MoveTo(w, ox, oy-2);
Windows.ResetWindow;
GetPos(ix,iy); (* wait for mouse click *)
Clear(v);
WriteString ('drawing Julia Set.'); WriteLn;
lim := 100;
SetColours(lim);
Fractal(ux, uy, -2.25, -2.25, 4.5);
ox := TRUNC( ((ux + 2.25) * FLOAT(NrPixels) / 4.5) );
oy := TRUNC( ((uy + 2.25) * FLOAT(NrPixels) / 4.5) );
Windows.SetWindow(v);
ForeColour(zyan);
SetPen(v,ox+1,oy); MoveTo(v, ox+3, oy);
SetPen(v,ox-1,oy); MoveTo(v, ox-3, oy);
SetPen(v,ox,oy+1); MoveTo(v, ox, oy+3);
SetPen(v,ox,oy-1); MoveTo(v, ox, oy-3);
ForeColour(black);
ox := NrPixels DIV 2; oy := ox;
SetPen(v,ox+1,oy); MoveTo(v, ox+3, oy);
SetPen(v,ox-1,oy); MoveTo(v, ox-3, oy);
SetPen(v,ox,oy+1); MoveTo(v, ox, oy+3);
SetPen(v,ox,oy-1); MoveTo(v, ox, oy-3);
Windows.ResetWindow;
WriteString ('continue Y/N:');
Read(ch); Write(CAP(ch)); WriteLn;
IF CAP(ch) # "Y" THEN EXIT END;
END;
CloseGraphicWindow(w);
CloseGraphicWindow(v);
END Mandelbrot.